(defun make-env (largs)
  (labels ((aux (l n)
                (if (null l)
                  l
                  (cons (cons (car l) (- n))
                        (aux (cdr l) (1- n))))))
    (aux largs (1+ (length largs)))))


(defun map-lisp-to-vm (expr env uni)
  (if (atom expr) nil
    (append (lisp-to-vm (car expr) env uni)
            (map-lisp-to-vm (cdr expr) env uni))))

(defun addr0 (expr)
  `( ,@expr (PUSH r0)))

(defun lisp-to-vm (expr env uni)
  (cond((and (atom expr) ;constantes
	     (constantp expr))
	`((move ,expr R0)))
					
       ((or (atom expr) 
	    (symbolp expr)) ;variables
	`((load  ,`(FP ,(cdr (assoc expr env))R0 ) )))

       ((eq 'defun (car expr)) ; Expression du defun
	`((DEFUN ,(cadr expr)),@(lisp-to-vm (cadddr expr) (make-env (caddr expr)) uni)
	  (halt)(rtn)))
       
       ((and (eq 3 (length expr))
	     (eq '+ (car expr))) ;operateur + binaire
	`(,@(lisp-to-vm (cadr expr) env uni)
	  (push R0)
	  ,@(lisp-to-vm (caddr expr) env uni)
	  (pop R1)
	  (ADD R1 R0)))
       
       ((and (eq 3 (length expr))
	     (eq '- (car expr))) ;operateur - binaire
	`(,@(lisp-to-vm (cadr expr) env uni)
	  (push R0)
	  ,@(lisp-to-vm (caddr expr) env uni)
	  (pop R1)
	  (SUB R1 R0)))
       
       ((and (eq 3 (length expr))
	     (eq '* (car expr))) ;operateur * binaire
	`(,@(lisp-to-vm (cadr expr) env uni)
	  (push R0)
	  ,@(lisp-to-vm (caddr expr) env uni)
	  (pop R1)
	  (MULT R1 R0)))

       ((and (eq 3 (length expr))
	     (eq '/ (car expr))) ;operateur / binaire
	(if (= (caddr expr) 0)
	    (print 'ERREUR_DIVISION_PAR_ZERO)
	  `(,@(lisp-to-vm (cadr expr) env uni)
	    (push R0)
	    ,@(lisp-to-vm (caddr expr) env uni)
	    (pop R1)
	     (DIV R1 R0))))
       
					; if
       ((eq 'if (car expr))
	`(,@(lisp-to-vm (cadadr expr) env uni)
	  (PUSH r0)
	  ,@(lisp-to-vm (caddr (cadr expr)) env uni)
	  (POP R1)
	  (COMP R1 r0)
	  (,(cond ((or (eq (caadr expr) '=) (eq (caadr expr) 'eq)) 'JEQ)
		  ((eq (caadr expr) '<) 'JPP)
		  ((eq (caadr expr) '>) 'JPG)
		  ((eq (caadr expr) '<=) 'JPE)
		  ((eq (caadr expr) '>=) 'JGE )
		  ('ERREUR_SAUT)) oui,uni)
	  ,@(lisp-to-vm (cadddr expr) env (+ 1 uni))
	  (JMP fin,uni)
	  (ETIQ oui,uni)
	  ,@(lisp-to-vm (caddr expr) env (+ 1 uni))
	  (ETIQ fin,uni)))
       
       
					; fonction
       ((fboundp (car expr))
	`(,@(funcall #'addr0 (map-lisp-to-vm (cdr expr) env uni))
	  (PUSH  ,(length (cdr expr)))
	  (MOVE SP r2)
	  (DECR r2)
	  (DECR r2)
	  (PUSH r2)
	  (PUSH FP)
	  (JSR ,(car expr))
	  (POP FP)
	  (POP SP)
	  (halt)))
       
       
       ( () )))


(defun fibo (n)
  (if (< n 2)
      1
    (+ (fibo (- n 1)) (fibo (- n 2)))))


